Recursively solves the 24 game by trying all possible operations. Utilizes OpenMP tasks for parallelization.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real, | intent(in) | :: | nums(:) |
Input: Array of numbers. |
||
character(len=expr_len), | intent(in) | :: | exprs(:) |
Input: Array of string expressions representing the numbers. |
||
logical, | intent(inout) | :: | found |
Input/Output: Flag indicating if a solution is found. |
recursive subroutine solve_24(nums, exprs, found) !! Recursively solves the 24 game by trying all possible operations. !! Utilizes OpenMP tasks for parallelization. real, intent(in) :: nums(:) !! Input: Array of numbers. character(len=expr_len), intent(in) :: exprs(:) !! Input: Array of string expressions representing the numbers. logical, intent(inout) :: found !! Input/Output: Flag indicating if a solution is found. integer :: n !! Size of the input arrays. integer :: i, j, op !! Loop counters for numbers and operators. real :: a, b, result !! Temporary variables for calculations. real, allocatable :: new_nums(:) !! Temporary array to store numbers after an operation. character(len=expr_len), allocatable :: new_exprs(:) !! Temporary array to store expressions after an operation. character(len=expr_len) :: expr_a, expr_b, new_expr !! Temporary variables for expressions. n = size(nums) ! Increment the completed_calls counter and update progress bar if (show_progress) then !$omp atomic completed_calls = completed_calls + 1 call update_progress_bar() end if ! If a solution is found, return if (found) return ! Base case: If only one number is left, check if it is 24 if (n == 1) then if (abs(nums(1) - 24.0) < 1e-4) then if (show_progress) then write (*, '(A, F5.1, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] ', 100.0, '%' write (*, '(A)') '' ! Insert a blank line end if !$omp critical write (*, '(A, A, A, F10.7, A)') 'Solution found:', trim(exprs(1)), '= 24 (', nums(1), ')' found = .true. !$omp end critical end if return end if ! Iterate over all pairs of numbers do i = 1, n - 1 do j = i + 1, n a = nums(i) b = nums(j) expr_a = exprs(i) expr_b = exprs(j) ! Iterate over all operators do op = 1, 4 ! Avoid division by zero if ((op == 4 .and. abs(b) < 1e-6)) cycle ! Perform the operation and create the new expression select case (op) case (1) result = a + b new_expr = '('//trim(expr_a)//'+'//trim(expr_b)//')' case (2) result = a - b new_expr = '('//trim(expr_a)//'-'//trim(expr_b)//')' case (3) result = a * b new_expr = '('//trim(expr_a)//'*'//trim(expr_b)//')' case (4) result = a / b new_expr = '('//trim(expr_a)//'/'//trim(expr_b)//')' end select ! Create new arrays with the selected numbers removed call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs) ! For the first few recursion levels, create parallel tasks if (n >= 6 .and. omp_get_level() < 2) then !$omp task shared(found) firstprivate(new_nums, new_exprs) call solve_24(new_nums, new_exprs, found) !$omp end task else call solve_24(new_nums, new_exprs, found) end if ! If a solution is found, deallocate memory and return if (found) then deallocate (new_nums) deallocate (new_exprs) return end if ! Handle commutative operations only once if (op == 1 .or. op == 3) cycle ! Swap operands for subtraction and division if (op == 2 .or. op == 4) then if (op == 4 .and. abs(a) < 1e-6) cycle ! Avoid division by zero select case (op) case (2) result = b - a new_expr = '('//trim(expr_b)//'-'//trim(expr_a)//')' case (4) result = b / a new_expr = '('//trim(expr_b)//'/'//trim(expr_a)//')' end select ! Create new arrays with the selected numbers removed call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs) ! For the first few recursion levels, create parallel tasks if (n >= 6 .and. omp_get_level() < 2) then !$omp task shared(found) firstprivate(new_nums, new_exprs) call solve_24(new_nums, new_exprs, found) !$omp end task else ! Recursively call the solve_24 function with the new arrays call solve_24(new_nums, new_exprs, found) end if ! If a solution is found, deallocate memory and return if (found) then deallocate (new_nums) deallocate (new_exprs) return end if end if end do ! End of operator loop end do ! End of j loop end do ! End of i loop end subroutine solve_24